#!/usr/bin/perl
use warnings;
use strict;
use diagnostics;
use Net::OSCAR;
use Socket;
use DB_File;
use XML::Simple;
use Text::Iconv;

#### TODO: В аську писать кто JOIN,PART, QUIT, изменения топика с каналов итд
#### Сделать возможность админам дропать сессию уинов
#### Антифлуд, антиповтор, гейтовые виртуальные моды на канал(т.е. мода на непропуск цветов, ссылок, итд итп, пасс на гейт, лимит на гейт итд итп)
#### Пул уинов, динамическое распределение юзеров на уины
#### Писать в ирку об окончании сессии icq уина (Parts ALIAS(UIN) (Ping timeout)) или подобное
#### Еще бы антирепит и антифлуд с ирковой стороны сделать
#### !!!!!!!!! Почистить код, оптимизировать и причесать :)
my ($debug, $ircserv, $ircport, $ircchan, $ircnick, $icquin, $icqpass, $icqc, $ircc, %alias, @alias_l, %ignore, 
    @ignore_l ,%auth, %admins, $owner_nick, @admin_l,%vip,@vip_l,%session,$session_time,$session_type,$conf,
    $log_file,$irc_char,@vip_help,@pub_help,@adm_help,@own_help,$icq_vip_help,$tmp_help,$time_now,$irc_to_icq_iconv,
    $icq_to_irc_iconv);

my $conf = XMLin('config.xml') or die "Config not found\n";
my $help = XMLin('help.xml') or die "Help not found\n";
$ircserv = $conf->{server}->{host};
$ircport = $conf->{server}->{port};
$ircchan = $conf->{server}->{channel};
$ircnick = $conf->{server}->{nick};
$icquin = $conf->{icq}->{uin};
$icqpass = $conf->{icq}->{password};
$owner_nick = $conf->{server}->{owner};
$session_type = $conf->{session}->{type};
$session_time = $conf->{session}->{timeout};
$log_file = $conf->{files}->{logfile};
$irc_char = $conf->{server}->{encoding};
$irc_to_icq_iconv = Text::Iconv->new("$irc_char", "cp1251");
$icq_to_irc_iconv = Text::Iconv->new("cp1251", "$irc_char");
$debug = 1 if $log_file;
wlog("Config loaded\n") if $debug > 0;

my $pub_help = $help->{pub};
my $adm_help = $help->{admin};
my $own_help = $help->{owner};
my $vip_help = $help->{vip};
my $icq_help = $help->{icq};





@pub_help = split("\n",$pub_help);
@adm_help = split("\n",$adm_help);
@own_help = split("\n",$own_help);
@vip_help = split("\n",$vip_help);
$icq_vip_help = $icq_help;

wlog("Help loaded\n") if $debug > 0;
local $SIG{'ALRM'} = \&do_loop;
$icqc = new Net::OSCAR;
$icqc->signon($icquin, $icqpass) or die 'Cannot connect, using UIN and PASSWORD!';
socket(IRCSOCK , PF_INET, SOCK_STREAM, getprotobyname('tcp'));
connect(IRCSOCK , sockaddr_in($ircport, inet_aton($ircserv))) or die 'Cannot connect to IRC';
$icqc->set_callback_im_in(\&im_in) or die 'Cannot set callback!';
$icqc->loglevel(1);
alarm(1);
&connect;


dbmopen(%admins,"admins.db", 0777) or die 'Cannot open admins.db';
while(my ($key,$value) = each %admins){
  $auth{$key} = '0';
}
dbmclose(%admins);



sub connect{
  send (IRCSOCK , "USER $ircnick 8 * :$ircnick\r\n", 0);
  send (IRCSOCK , "NICK $ircnick\r\n", 0);
  while (my $ircmsg = <IRCSOCK>){
    $icqc->do_one_loop;
    chop $ircmsg;
    print "$ircmsg\n" if $debug > 0;
    send (IRCSOCK , "JOIN $ircchan\r\n", 0) if ($ircmsg =~ /001/o);
    send (IRCSOCK , "PONG $1\r\n", 0) if ($ircmsg =~ /^PING(.*)$/io);
    if($ircmsg=~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :!quit$/io){
      my($nick, $user, $host, $channel) = ($1, $2, $3, $4);
      if($nick eq $owner_nick) {
	send (IRCSOCK , "QUIT :Requested\r\n", 0);
	$icqc->signoff();
	die 'Requested from IRC';
      } else {
	send_to_irc("You have no privilegies to do that.","$nick");
      }
    }
    # Объеденить все одинаковые регекспы в один, потом уже по командам if'ы делать...
    # Хелп переделать в XML


    if($ircmsg=~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :!alias (.*?)$/io){
      my($nick, $user, $host, $channel, $msg) = ($1, $2, $3, $4, $5);
      @alias_l = split(" ",$msg);
      alias($alias_l[0],$alias_l[1],$alias_l[2],$nick);
    }
    if($ircmsg=~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :!ignore (.*?)$/io){
      my($nick, $user, $host, $channel, $msg) = ($1, $2, $3, $4, $5);
      @ignore_l = split(" ",$msg);
      ignore($ignore_l[0],$ignore_l[1],$nick);
    }
    if($ircmsg=~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :!vip (.*?)$/io){
      my($nick, $user, $host, $channel, $msg) = ($1, $2, $3, $4, $5);
      @vip_l = split(" ",$msg);
      vip($vip_l[0],$vip_l[1],$nick);
    }
    if($ircmsg=~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :!invite (.*?)$/io){
      my($nick, $user, $host, $channel, $msg) = ($1, $2, $3, $4, $5);
      send_invite($msg,$nick);
    }
    if($ircmsg=~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :admin (.*?)$/io){
      my($nick, $user, $host, $mynick, $msg) = ($1, $2, $3, $4, $5);
      my @adminz = split(" ",$msg);
      admin($nick,@adminz);
    }
    if($ircmsg=~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :!admin list(.*?)$/io){
      my($nick, $user, $host, $channel) = ($1, $2, $3, $4);
      showadmins($nick);
    }
    if($ircmsg=~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :auth (.*?)$/io){
      my($nick, $user, $host, $mynick, $msg) = ($1, $2, $3, $4, $5);
      auth($nick,$msg) if $mynick eq $ircnick;
    }

    if($ircmsg=~ m/^\:(.*?)\!(.*?)\@(.*?) PART (.*?) :(.*?)$/io){
      my($nick, $user, $host, $channel, $msg) = ($1, $2, $3, $4, $5);
      $auth{$nick} = '0' if $auth{$nick};
    }
    if($ircmsg=~ m/^\:(.*?)\!(.*?)\@(.*?) QUIT (.*?) :(.*?)$/io){
      my($nick, $user, $host, $channel, $msg) = ($1, $2, $3, $4, $5);
      $auth{$nick} = '0' if $auth{$nick};
    }

    if($ircmsg=~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :!help(.*?)$/io){
      my($nick, $user, $host, $channel) = ($1, $2, $3, $4);
      if(($nick eq $owner_nick) or ($admins{$nick} and $auth{$nick} == 1) or vip('get',"$nick")) {
	if($nick eq $owner_nick){
	  for(my $i=0;@own_help>$i;$i++){
	    send_to_irc("$own_help[$i]",$nick);
	  }
	  for(my $i=0;@adm_help>$i;$i++){
	    send_to_irc("$adm_help[$i]",$nick);
	  }
	  for(my $i=0;@vip_help>$i;$i++){
	    send_to_irc("$vip_help[$i]",$nick);
	  }
	  for(my $i=0;@pub_help>$i;$i++){
	    send_to_irc("$pub_help[$i]",$nick);
	  }
	}
	if($admins{$nick} and $auth{$nick} == 1){
	  for(my $i=0;@adm_help>$i;$i++){
	    send_to_irc("$adm_help[$i]",$nick);
	  }
	  for(my $i=0;@vip_help>$i;$i++){
	    send_to_irc("$vip_help[$i]",$nick);
	  }
	  for(my $i=0;@pub_help>$i;$i++){
	    send_to_irc("$pub_help[$i]",$nick);
	  }
	}
	if(vip('get',"$nick")){
	  for(my $i=0;@vip_help>$i;$i++){
	    send_to_irc("$vip_help[$i]",$nick);
	  }
	  for(my $i=0;@pub_help>$i;$i++){
	    send_to_irc("$pub_help[$i]",$nick);
	  }
	}
      } else {
	for(my $i=0;@pub_help>$i;$i++){
	  send_to_irc("$pub_help[$i]",$nick);
	}
      }
    }
    if ($ircmsg =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :!icq (.*?) (.*?)$/io){
      my($nick, $user, $host, $channel, $uin, $msg) = ($1, $2, $3, $4, $5, $6);
      unless(ignore('get',$nick) or ignore('get',$uin) or alias('get',$uin) eq (ignore('get',$uin) != 0)){
	unless($uin =~ m/[0-9]/){
	  if(alias('get',"$uin")){
	    $uin = alias('get',"$uin");
	  } else {
	    send_to_irc("Alias $uin not found...","$ircchan");
	  }
	}
	#### Вот эту херь тоже вычистить надо-бы, в одной замене сделать =\
	$msg = "<$nick> $msg";
	$uin =~ s/\r//;
	$uin =~ s/\n//;
	$uin =~ s/\s+$//;
	$uin =~ s/^\s+//;
	$msg =~ s/\r//;
	$msg =~ s/\n//;
	&send_to_icq($uin, $msg);
      } else {
	send_to_irc('Your uin or nick is in ignore list',$ircchan);
      }
    }
    #### TODO: Объеденить все условия в одно, а то криво смотрица =\
    if(my($nick, $user, $host, $channel, $msg) = $ircmsg=~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/){
      #			my($nick, $user, $host, $channel, $msg) = ($1, $2, $3, $4, $5);
      unless(ignore('get',$nick)){
	if($channel eq $ircchan){
	  unless($msg=~ m/^!(.*?)/){
	    if($session_type eq 'full'){
	      chop($msg);
	      while(my ($key,$value) = each %session){
		send_to_icq($key,"<$nick> $msg");
	      }
	    }
	  }
	}
      }
    }
  }
}

sub send_to_irc{
  my ($mesg,$chan) = @_;
  # То же самое для замены =\
  $mesg =~ s/\r//g;
  $mesg =~ s/\n//g;
  $mesg =~ s/\s+$//g;
  $mesg = $icq_to_irc_iconv->convert("$mesg");
  if(length($mesg)>450){
    for(my $i=0; $i<length($mesg); $i=$i+450) {
      my $s_mesg = substr($mesg,$i,450);
      send (IRCSOCK , "PRIVMSG $chan :$s_mesg\n", 0);
    }
  } else {
    send (IRCSOCK , "PRIVMSG $chan :$mesg\n", 0);
  }
  chop $mesg;
}


sub send_to_icq{
  my($uin, $msg) = @_;
  $msg = $irc_to_icq_iconv->convert("$msg");
  $icqc->send_im($uin, $msg);
}


sub im_in{
  my($oscar, $sender, $message, $is_away) = @_;
  alarm(1);
  if($message eq '!start'){
    session('start',$sender);
    $message = "ICQ User has joined";
  }
  if(session('get',$sender)){
    unless(ignore('get',$sender)){
      $session{$sender} = time();
      if($message=~ m/^!topic (.*?)$/){
	my $newtopic = $1;
	if(vip('get',$sender)){
	  if($newtopic){
	    send (IRCSOCK , "TOPIC $ircchan :$newtopic ($sender)\r\n", 0);
	  }
	}
      }
      if($message eq '!who'){
	if(vip('get',$sender)){
	  send_to_icq($sender,get_irc_nick());
	}
      }	
      if($message=~ m/^!private (.*?) (.*?)$/){
	my $privnick = $1;
	my $privmsg = $2;
	if(vip('get',$sender)){
	  if(alias('get',"$sender")){
	    $sender = alias('get',"$sender");
	  }
	  send_to_irc("<$sender> $privmsg" ,$privnick);
	}
      }
      if($message eq '!help'){
	if(vip('get',$sender)){
	  send_to_icq($sender,"$icq_vip_help");
	}
      }
      if($message eq '!stop'){
	session('stop',$sender);
	$message = "ICQ User $sender left channel";
      }
      if(alias('get',"$sender")){
	$sender = alias('get',"$sender");
      }
      my $msg = "<$sender> $message";
      unless($message =~ m/^!(.*?)/){
	send_to_irc("$msg","$ircchan");
	while(my ($key,$value) = each %session){
	  send_to_icq($key,"<$sender> $message") unless(($sender eq $key) or ($sender eq alias('get',$key)));
	  print "[DEBUG] S: $sender U: $key A:".alias('get',$key	)."\n\n";
	}
      }
    } else {
      send_to_icq($sender,"You are in ignore list");
    }
  } else {
    send_to_icq($sender,"Greetings, $sender. I'm an ICQ2IRC Gate bot, i'm gating to $ircserv $ircchan.Type !start to join the channel.");
  }
}





sub do_loop{
  $icqc->do_one_loop;
  session('clear'); 
  alarm(1);

}

sub alias {
  dbmopen(%alias,"alias.db", 0777);
  if($_[0] eq 'get'){
    if($alias{$_[1]}){
      return("$alias{$_[1]}");
    } else {
      return(0);
    }
  }
  dbmopen(%admins,"admins.db", 0777);
  my $nick = $_[3];
  if(($nick eq $owner_nick) or ($admins{$nick} and $auth{$nick} == 1)) {
    if($_[0] eq 'add'){
      if($alias{$_[1]}){
	send_to_irc('This alias already exist',"$ircchan");
      } else {
	$alias{$_[1]} = $_[2];
	send_to_irc("$_[1] => $_[2] alias is successfully added","$ircchan");
      }
    }
    if($_[0] eq 'del'){
      if($alias{$_[1]}){
	delete($alias{$_[1]});
	send_to_irc("$_[1] => $_[2] alias is successfully deleted","$ircchan");
      } else {
	send_to_irc('Such alias is not found in base',"$ircchan");
      }
    }

  } elsif($admins{$nick} and $auth{$nick} == '0'){
    send_to_irc("You must auth to do that","$nick");
  } else {
    send_to_irc("You have no privilegies to do that","$nick");
  }
  if($_[0] eq 'list'){
    send_to_irc("Alias list:","$_[3]");
    while(my ($key,$value) = each %alias){
      send_to_irc("$key => $value","$_[3]");
    }
  }
  dbmclose(%alias);
  dbmclose(%admins);
}

sub ignore {
  dbmopen(%ignore,"ignore.db", 0777);
  if($_[0] eq 'get'){
    if($ignore{$_[1]}){
      return("$ignore{$_[1]}");	
    } else {
      return(0);
    }
  }

  dbmopen(%admins,"admins.db", 0777);
  my $nick = $_[2];
  if(($nick eq $owner_nick) or ($admins{$nick} and $auth{$nick} == 1)) {
    if($_[0] eq 'add'){
      if($ignore{$_[1]}){
	send_to_irc('This ignore already exist',"$ircchan");
      } else {
	$ignore{$_[1]} = ' ';
	send_to_irc("$_[1] ignore is successfully added","$ircchan");
      }
    }

    if($_[0] eq 'del'){
      if($ignore{$_[1]}){
	delete($ignore{$_[1]});
	send_to_irc("$_[1] ignore is successfully deleted","$ircchan");
      } else {
	send_to_irc('Such ignore is not found in base',"$ircchan");
      }
    } 
  } elsif($admins{$nick} and $auth{$nick} == '0') {
    send_to_irc("You must auth to do that","$nick");
  } else {
    send_to_irc("You have no privilegies to do that","$nick");
  }
  if($_[0] eq 'list'){
    send_to_irc("Ignore list:","$_[2]");
    while(my ($key,$value) = each %ignore){
      send_to_irc("$key","$_[2]");
    }
  }
  dbmclose(%ignore);
  dbmclose(%admins);
}

sub admin {
  dbmopen(%admins,"admins.db", 0777);
  my $nick = shift;
  @admin_l = @_;
  $admin_l[1] =~ s/\r// if $admin_l[1];
  $admin_l[1] =~ s/\n// if $admin_l[1];
  if($nick eq $owner_nick) {
    if($admin_l[0] eq 'add' and $admin_l[1]){
      if($admins{$admin_l[1]}){
	send_to_irc('Admin with such name exists',"$nick");
      } else {
	$admins{$admin_l[1]} = $admin_l[2];
	$auth{$admin_l[1]} = '0';
	send_to_irc("$admin_l[1] admin has been successfully added","$nick");
      }
    } elsif($admin_l[0] eq 'add' and !$admin_l[1]){
      send_to_irc("You must specify password for admin","$nick");
    }

    if($admin_l[0] eq 'del'){
      if($admins{$_[1]}){
	delete($admins{$admin_l[1]});
	delete($auth{$admin_l[1]});
	send_to_irc("$admin_l[1] admin is successfully deleted","$nick");
      } else {
	send_to_irc('Such admin is not found in base',"$nick");
      }

    }
  } else {
    send_to_irc("You have no privilegies to do that","$nick");
  }
  if($admin_l[0] eq 'list'){
    send_to_irc("Admins list:","$nick");
    while(my ($key,$value) = each %admins){
      send_to_irc("$key","$nick");
    }
  }
  dbmclose(%admins);
}

sub showadmins {
  my $nick = shift;
  dbmopen(%admins,"admins.db", 0777);
  send_to_irc("Admins list:","$nick");
  while(my ($key,$value) = each %admins){
    send_to_irc("$key","$nick");
  }
  dbmclose(%admins);
}

sub auth {
  my($username,$password) = @_;
  dbmopen(%admins,"admins.db", 0777);
  wlog("Presented pass |$password|\n") if $debug > 0;
  $password =~ s/\r//;
  $password =~ s/\n//;
  wlog("Processed pass |$password|\n") if $debug > 0;
  if($admins{$username}){
    if($admins{$username} eq $password){
      wlog("Admin with $username authorized with $password\n") if $debug > 0;
      send_to_irc("Your authentication is successfull","$username");
      $auth{$username} = '1';
    } else { 
      wlog("Admin with $username trying to authorize with $password , but password is wrong\n") if $debug > 0;
      send_to_irc("Your password is wrong","$username");
    }
  } else {
    send_to_irc("You have no account on bot","$username");
  }
  dbmclose(%admins);
}

sub vip {
  dbmopen(%vip,"vip.db", 0777);
  if($_[0] eq 'get'){
    if($vip{$_[1]}){
      return("$vip{$_[1]}");
    } else {
      return(0);
    }
  }

  dbmopen(%admins,"admins.db", 0777);
  my $nick = $_[2];
  if(($nick eq $owner_nick) or ($admins{$nick} and $auth{$nick} == 1)) {
    if($_[0] eq 'add'){
      if($vip{$_[1]}){
	send_to_irc('This vip-user already exist',"$ircchan");
      } else {
	$vip{$_[1]} = ' ';
	send_to_irc("$_[1] vip-user is successfully added","$ircchan");
      }
    }

    if($_[0] eq 'del'){
      if($vip{$_[1]}){
	delete($vip{$_[1]});
	send_to_irc("$_[1] vip-user is successfully deleted","$ircchan");
      } else {
	send_to_irc('Such vip-user is not found in base',"$ircchan");
      }
    }

  } elsif($admins{$nick} and $auth{$nick} == '0') {
    send_to_irc("You must auth to do that","$nick");
	} else {
	  send_to_irc("You have no privilegies to do that","$nick");
	}

  if($_[0] eq 'list'){
    send_to_irc("Vip-User list:","$_[2]");
    while(my ($key,$value) = each %vip){
      send_to_irc("$key","$_[2]");
    }
  }
  dbmclose(%vip);
  dbmclose(%admins);
}

sub send_invite {
  my $nick = $_[1];
  dbmopen(%admins,"admins.db", 0777);
  if(($nick eq $owner_nick) or ($admins{$nick} and $auth{$nick} == 1) or vip('get',"$nick")) {
    send_to_icq($_[0],"User $nick invites you on irc a server $ircserv (channel $ircchan). You can come there by means of any irc the client. Or to take advantage of this gate.");
  } else {
    send_to_irc("You have no privilegies to do that","$nick");
  }
}

sub session {
  if($_[0] eq 'start'){
    if($session{$_[1]}){
      send_to_icq($_[1],"Your session is already begun");
    } else {
      $session{$_[1]} = time();
      send_to_icq($_[1],"Session is started");
      if(vip('get',$_[1])){
	send_to_icq($_[1],"You status: VIP");
	send_to_icq($_[1],"Type !help for that what to learn the list of commands accessible to you");
	send_to_icq($_[1],"List of users on irc-channel:");
	send_to_icq($_[1],get_irc_nick());
      } else {
	send_to_icq($_[1],"You status: Normal user");
      }
    }
  }

  if($_[0] eq 'stop'){
    if($session{$_[1]}){
      delete($session{$_[1]});
      send_to_icq($_[1],"Session is stopped");
    }
  }

  if($_[0] eq 'clear'){
    while(my ($key,$value) = each %session){
      if(time()-$value > $session_time){
	delete($session{$key});
      }
    }
  }

  if($_[0] eq 'get'){
    if($session{$_[1]}){
      return("$session{$_[1]}");
    } else {
      return(0);
    }
  }
}



sub wlog {
  open(LGWR,">> $log_file");
  $time_now = localtime();
  print LGWR "[$time_now] $_[0]";
  close(LGWR);
}

sub get_irc_nick {
  send (IRCSOCK , "NAMES $ircchan\r\n", 0);
  my $irc_nick_list;
  while(<IRCSOCK>){
    if($_=~ m/^:(.*?) 353 $ircnick = $ircchan :(.*?)$/){$irc_nick_list .= $2}
    if($_=~ m/366/){last;}
  }
  chop($irc_nick_list);
  return($irc_nick_list);
}
